home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / DDPLUS71 / RIPLINK.ZIP / RIPLINK1.PAS < prev    next >
Pascal/Delphi Source File  |  1994-07-05  |  9KB  |  252 lines
  1. {.$A+,B-,D+,E-,F+,G-,I+,L+,N-,O+,P-,Q-,R-,S-,T-,V-,X+,Y+}
  2. {.$D-,L-,Y-}
  3. Unit RipLink1;
  4. {$F+,O+}
  5.  
  6. interface
  7.  
  8. {$I RIPLINK.PA2}
  9. const
  10.   MegaArray : array[0..35] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  11.  
  12. type
  13.   Str2  = string[2];
  14.   Str4  = string[4];
  15.  
  16.   CharMapRecord = record
  17.     s8x8   : Array[1..8] of Byte;
  18.     s7x8   : Array[1..8] of Byte;
  19.     s8x14  : Array[1..14] of Byte;
  20.     s7x14  : Array[1..14] of Byte;
  21.     s16x14 : Array[1..14] of Word;
  22.   end;
  23.  
  24. Function IntToStr(I: longint) : string;
  25. Function StrToInt(S: string) : longint;
  26. Function BackSlash(instring : string) : string;
  27. Function EscapeString(instring : string) : string;
  28. Function Exists(FN : string) : boolean;
  29. Function WordToMega(Num : word) : Str2;
  30. Function WordToMega4(Num : word) : Str4;
  31. Function MegaToWord(S2 : Str2) : Word;
  32. Function Mega4ToLong(S4 : Str4) : Longint;
  33. Procedure DisplayChar(x,y:word;clr,bclr:byte;c:CharMapRecord;tsize:byte);
  34.  
  35. implementation
  36.  
  37. uses
  38.   dos,graph;
  39.  
  40. Function IntToStr(I: longint) : string;
  41. var
  42.   s     : string[11];
  43. begin
  44.   str(I,S);
  45.   inttostr := s;
  46. end;
  47.  
  48. Function StrToInt(S: string) : longint;
  49. var
  50.   I     : longint;
  51.   code  : integer;
  52. begin
  53.   I := 0;
  54.   val(S,I,code);
  55.   strtoint := I;
  56. end;
  57.  
  58. Function BackSlash(instring : string) : string;
  59. begin
  60.   if not ((instring[length(instring)]) = '\') then
  61.     backslash := instring + '\'
  62.   else
  63.     backslash := instring;
  64. end;
  65.  
  66. Function EscapeString(instring : string) : string;
  67. var
  68.   st : string;
  69.   c  : byte;
  70. begin
  71.   st := '';
  72.   for c := 1 to length(instring) do
  73.   begin
  74.     if instring[c] in ['!','\','|'] then
  75.       st := st + '\';
  76.     st := st + instring[c];
  77.   end;
  78.   escapestring := st;
  79. end;
  80.  
  81. Function Exists(FN : string) : boolean;
  82. var
  83.   F     : searchrec;
  84. begin
  85.   findfirst (FN,AnyFile,F);
  86.   Exists := DosError = 0;
  87. end;
  88.  
  89. Function WordToMega(Num : word) : Str2;
  90. var
  91.   work          : str2;
  92. begin
  93.   work := '';
  94.   if (Num < 0) or (Num > 1295) then
  95.   begin
  96.     WordToMega := '  ';
  97.     Exit;
  98.   end;
  99.   while Num >0 do
  100.   begin
  101.     work := megaarray[num mod 36]+work;
  102.     num := num div 36;
  103.   end;
  104.   while length(work)<2 do
  105.     work := '0'+work;
  106.   WordToMega := work;
  107. end;
  108.  
  109. Function WordToMega4(Num : word) : Str4;
  110. var
  111.   work          : str4;
  112. begin
  113.   work := '';
  114.   while Num >0 do
  115.   begin
  116.     work := megaarray[num mod 36]+work;
  117.     num := num div 36;
  118.   end;
  119.   while length(work)<4 do
  120.     work := '0'+work;
  121.   WordToMega4 := work;
  122. end;
  123.  
  124. Function MegaToWord(S2 : Str2) : Word;
  125. var
  126.   Num           : word;
  127. begin
  128.   num := 0;
  129.   if not ord(upcase(s2[1])) in [48..57,65..90] then Exit;
  130.   if not ord(upcase(s2[2])) in [48..57,65..90] then Exit;
  131.   while s2 <> '' do
  132.   begin
  133.     if s2[1] > '9' then
  134.       num := num*36+ord(s2[1])-55
  135.     else
  136.       num := num*36+ord(s2[1])-48;
  137.     delete(s2,1,1);
  138.   end;
  139.   MegaToWord := num;
  140. end;
  141.  
  142. Function Mega4ToLong(S4 : Str4) : Longint;
  143. var
  144.   Num           : longint;
  145. begin
  146.   num := 0;
  147.   if not ord(upcase(s4[1])) in [48..57,65..90] then Exit;
  148.   if not ord(upcase(s4[2])) in [48..57,65..90] then Exit;
  149.   if not ord(upcase(s4[3])) in [48..57,65..90] then Exit;
  150.   if not ord(upcase(s4[4])) in [48..57,65..90] then Exit;
  151.   while s4 <> '' do
  152.   begin
  153.     if s4[1] > '9' then
  154.       num := num*36+ord(s4[1])-55
  155.     else
  156.       num := num*36+ord(s4[1])-48;
  157.     delete(s4,1,1);
  158.   end;
  159.   Mega4ToLong := num;
  160. end;
  161.  
  162. Function FlagOn(Flags : Byte; FlagMask : Byte) : Boolean;
  163. begin
  164.   if FlagMask = 0 then
  165.   begin
  166.     flagon := true;
  167.     exit;
  168.   end;
  169.   FlagOn := (Flags and FlagMask) <> 0;
  170. end;
  171.  
  172. Procedure DisplayChar(x,y:word;clr,bclr:byte;c:CharMapRecord;tsize:byte);
  173. var
  174.   ct : byte;
  175. begin
  176.   case tsize of
  177.     0 : begin {8x8}
  178.           for ct := 1 to 8 do
  179.           begin
  180.             if flagon(c.s8x8[ct],$01) then putpixel(x  ,y+ct-1,clr) else putpixel(x  ,y+ct-1,bclr);
  181.             if flagon(c.s8x8[ct],$02) then putpixel(x+1,y+ct-1,clr) else putpixel(x+1,y+ct-1,bclr);
  182.             if flagon(c.s8x8[ct],$04) then putpixel(x+2,y+ct-1,clr) else putpixel(x+2,y+ct-1,bclr);
  183.             if flagon(c.s8x8[ct],$08) then putpixel(x+3,y+ct-1,clr) else putpixel(x+3,y+ct-1,bclr);
  184.             if flagon(c.s8x8[ct],$10) then putpixel(x+4,y+ct-1,clr) else putpixel(x+4,y+ct-1,bclr);
  185.             if flagon(c.s8x8[ct],$20) then putpixel(x+5,y+ct-1,clr) else putpixel(x+5,y+ct-1,bclr);
  186.             if flagon(c.s8x8[ct],$40) then putpixel(x+6,y+ct-1,clr) else putpixel(x+6,y+ct-1,bclr);
  187.             if flagon(c.s8x8[ct],$80) then putpixel(x+7,y+ct-1,clr) else putpixel(x+7,y+ct-1,bclr);
  188.           end;
  189.         end;
  190.     1 : begin {7x8}
  191.           for ct := 1 to 8 do
  192.           begin
  193.             if flagon(c.s7x8[ct],$01) then putpixel(x  ,y+ct-1,clr) else putpixel(x  ,y+ct-1,bclr);
  194.             if flagon(c.s7x8[ct],$02) then putpixel(x+1,y+ct-1,clr) else putpixel(x+1,y+ct-1,bclr);
  195.             if flagon(c.s7x8[ct],$04) then putpixel(x+2,y+ct-1,clr) else putpixel(x+2,y+ct-1,bclr);
  196.             if flagon(c.s7x8[ct],$08) then putpixel(x+3,y+ct-1,clr) else putpixel(x+3,y+ct-1,bclr);
  197.             if flagon(c.s7x8[ct],$10) then putpixel(x+4,y+ct-1,clr) else putpixel(x+4,y+ct-1,bclr);
  198.             if flagon(c.s7x8[ct],$20) then putpixel(x+5,y+ct-1,clr) else putpixel(x+5,y+ct-1,bclr);
  199.             if flagon(c.s7x8[ct],$40) then putpixel(x+6,y+ct-1,clr) else putpixel(x+6,y+ct-1,bclr);
  200.           end;
  201.         end;
  202.     2 : begin {8x14}
  203.           for ct := 1 to 14 do
  204.           begin
  205.             if flagon(c.s8x14[ct],$01) then putpixel(x  ,y+ct-1,clr) else putpixel(x  ,y+ct-1,bclr);
  206.             if flagon(c.s8x14[ct],$02) then putpixel(x+1,y+ct-1,clr) else putpixel(x+1,y+ct-1,bclr);
  207.             if flagon(c.s8x14[ct],$04) then putpixel(x+2,y+ct-1,clr) else putpixel(x+2,y+ct-1,bclr);
  208.             if flagon(c.s8x14[ct],$08) then putpixel(x+3,y+ct-1,clr) else putpixel(x+3,y+ct-1,bclr);
  209.             if flagon(c.s8x14[ct],$10) then putpixel(x+4,y+ct-1,clr) else putpixel(x+4,y+ct-1,bclr);
  210.             if flagon(c.s8x14[ct],$20) then putpixel(x+5,y+ct-1,clr) else putpixel(x+5,y+ct-1,bclr);
  211.             if flagon(c.s8x14[ct],$40) then putpixel(x+6,y+ct-1,clr) else putpixel(x+6,y+ct-1,bclr);
  212.             if flagon(c.s8x14[ct],$80) then putpixel(x+7,y+ct-1,clr) else putpixel(x+7,y+ct-1,bclr);
  213.           end;
  214.         end;
  215.     3 : begin {7x14}
  216.           for ct := 1 to 14 do
  217.           begin
  218.             if flagon(c.s7x14[ct],$01) then putpixel(x  ,y+ct-1,clr) else putpixel(x  ,y+ct-1,bclr);
  219.             if flagon(c.s7x14[ct],$02) then putpixel(x+1,y+ct-1,clr) else putpixel(x+1,y+ct-1,bclr);
  220.             if flagon(c.s7x14[ct],$04) then putpixel(x+2,y+ct-1,clr) else putpixel(x+2,y+ct-1,bclr);
  221.             if flagon(c.s7x14[ct],$08) then putpixel(x+3,y+ct-1,clr) else putpixel(x+3,y+ct-1,bclr);
  222.             if flagon(c.s7x14[ct],$10) then putpixel(x+4,y+ct-1,clr) else putpixel(x+4,y+ct-1,bclr);
  223.             if flagon(c.s7x14[ct],$20) then putpixel(x+5,y+ct-1,clr) else putpixel(x+5,y+ct-1,bclr);
  224.             if flagon(c.s7x14[ct],$40) then putpixel(x+6,y+ct-1,clr) else putpixel(x+6,y+ct-1,bclr);
  225.           end;
  226.         end;
  227.     4 : begin {16x14}
  228.           for ct := 1 to 14 do
  229.           begin
  230.             if flagon(lo(c.s16x14[ct]),$01) then putpixel(x   ,y+ct-1,clr) else putpixel(x   ,y+ct-1,bclr);
  231.             if flagon(lo(c.s16x14[ct]),$02) then putpixel(x+1 ,y+ct-1,clr) else putpixel(x+1 ,y+ct-1,bclr);
  232.             if flagon(lo(c.s16x14[ct]),$04) then putpixel(x+2 ,y+ct-1,clr) else putpixel(x+2 ,y+ct-1,bclr);
  233.             if flagon(lo(c.s16x14[ct]),$08) then putpixel(x+3 ,y+ct-1,clr) else putpixel(x+3 ,y+ct-1,bclr);
  234.             if flagon(lo(c.s16x14[ct]),$10) then putpixel(x+4 ,y+ct-1,clr) else putpixel(x+4 ,y+ct-1,bclr);
  235.             if flagon(lo(c.s16x14[ct]),$20) then putpixel(x+5 ,y+ct-1,clr) else putpixel(x+5 ,y+ct-1,bclr);
  236.             if flagon(lo(c.s16x14[ct]),$40) then putpixel(x+6 ,y+ct-1,clr) else putpixel(x+6 ,y+ct-1,bclr);
  237.             if flagon(lo(c.s16x14[ct]),$80) then putpixel(x+7 ,y+ct-1,clr) else putpixel(x+7 ,y+ct-1,bclr);
  238.             if flagon(hi(c.s16x14[ct]),$01) then putpixel(x+8 ,y+ct-1,clr) else putpixel(x+8 ,y+ct-1,bclr);
  239.             if flagon(hi(c.s16x14[ct]),$02) then putpixel(x+9 ,y+ct-1,clr) else putpixel(x+9 ,y+ct-1,bclr);
  240.             if flagon(hi(c.s16x14[ct]),$04) then putpixel(x+10,y+ct-1,clr) else putpixel(x+10,y+ct-1,bclr);
  241.             if flagon(hi(c.s16x14[ct]),$08) then putpixel(x+11,y+ct-1,clr) else putpixel(x+11,y+ct-1,bclr);
  242.             if flagon(hi(c.s16x14[ct]),$10) then putpixel(x+12,y+ct-1,clr) else putpixel(x+12,y+ct-1,bclr);
  243.             if flagon(hi(c.s16x14[ct]),$20) then putpixel(x+13,y+ct-1,clr) else putpixel(x+13,y+ct-1,bclr);
  244.             if flagon(hi(c.s16x14[ct]),$40) then putpixel(x+14,y+ct-1,clr) else putpixel(x+14,y+ct-1,bclr);
  245.             if flagon(hi(c.s16x14[ct]),$80) then putpixel(x+15,y+ct-1,clr) else putpixel(x+15,y+ct-1,bclr);
  246.           end;
  247.         end;
  248.   end;
  249. end;
  250.  
  251. End.
  252.